1.Análisis discriminante

Se dispone información acerca de 16 clientes a los que se les concedió un préstamo instantáneo por un importe de 12.000 euros cada uno. Una vez pasados tres años desde la concesión de los préstamos había 8 clientes, de ese grupo de 16, que fueron clasificados como fallidos, mientras que los otros 8 clientes son cumplidores, ya que reintegraron el préstamo. Para cada uno de los clientes se dispone de información sobre su patrimonio neto y deudas pendientes correspondientes al momento de la solicitud. Con la información sobre las variabes de patrimonio neto y deudas pendientes se desea construir una función discriminante que clasifique con los menores errores posibles a los clientes en dos grupos: fallidos y no fallidos.

Librerías utilizadas y justificación

• MASS: contiene la función lda() que utilizaremos para construir la función discriminante lineal y clasificar las observaciones.

• ggplot2: permite visualizar la distribución de las variables y crear gráficos bivariantes que nos ayudarán a explorar la separación entre grupos.

• dplyr: facilita la manipulación de los datos, filtrado, mutación y agrupaciones de forma clara y estructurada.

• tibble: permite trabajar con data frames de forma más moderna y legible, especialmente útil para mantener estructuras limpias.

• ggpubr: mejora la presentación visual de los gráficos generados con ggplot2, facilitando su combinación y anotación.

• klar: ofrece funciones gráficas como partimat() para representar las fronteras de decisión generadas por modelos discriminantes.

• caret: proporciona herramientas para evaluar el rendimiento del modelo, generar matrices de confusión y aplicar validación cruzada.

# Creamos los vectores con los datos proporcionados
Patrimonio <- c(1.3, 3.7, 5, 5.9, 7.1, 4, 7.9, 5.1, 5.2, 9.8, 9, 12, 6.3, 8.7, 11.1, 9.9)
Deuda      <- c(4.1, 6.9, 3, 6.5, 5.4, 2.7, 7.6, 3.8, 1, 4.2, 4.8, 2, 5.2, 1.1, 4.1, 1.6)
Grupo      <- c(1, 1, 1, 1, 1, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0)

# Creamos el tibble y convertimos Grupo a factor
datos <- tibble(Patrimonio, Deuda, Grupo = as.factor(Grupo))

# Creamos los dos nuevos clientes a clasificar
nuevos <- tibble(
  Patrimonio = c(10.1, 9.7),
  Deuda = c(6.8, 2.2),
  Grupo = factor(c(NA, NA), levels = c("0", "1"))
)

Antes de aplicar el modelo de análisis discriminante lineal, realizamos una exploración gráfica de las variables. Representamos las distribuciones de patrimonio neto y deuda por separado, diferenciando los grupos de clientes cumplidores y fallidos. Esto nos permite analizar visualmente si las variables presentan patrones diferenciados que justifiquen la clasificación supervisada mediante LDA.

# Gráfico de densidad para Patrimonio
ggplot(datos, aes(x = Patrimonio, fill = Grupo)) +
  geom_density(alpha = 0.5) +
  labs(title = "Distribución de Patrimonio por Grupo",
       x = "Patrimonio Neto", y = "Densidad") +
  scale_fill_manual(values = c("#00AFBB", "#E7B800"),
                    labels = c("Cumplidores", "Fallidos")) +
  theme_minimal()

# Gráfico de densidad para Deuda
ggplot(datos, aes(x = Deuda, fill = Grupo)) +
  geom_density(alpha = 0.5) +
  labs(title = "Distribución de Deuda por Grupo",
       x = "Deuda Pendiente", y = "Densidad") +
  scale_fill_manual(values = c("#00AFBB", "#E7B800"),
                    labels = c("Cumplidores", "Fallidos")) +
  theme_minimal()

A continuación, representamos gráficamente las variables patrimonio neto y deuda de forma conjunta, diferenciando los grupos de clientes cumplidores y fallidos. Esta visualización nos permite observar la disposición relativa de los grupos en el plano bidimensional y valorar si existe una separación suficiente para que un modelo lineal pueda discriminar entre ellos.

# Calculamos los centroides por grupo
centroides <- datos %>%
  group_by(Grupo) %>%
  summarise(Patrimonio = mean(Patrimonio), Deuda = mean(Deuda))

# Gráfico bivariante
ggplot(datos, aes(x = Patrimonio, y = Deuda, color = Grupo)) +
  geom_point(size = 3, alpha = 0.8) +
  geom_point(data = centroides, aes(x = Patrimonio, y = Deuda),
             color = "black", size = 4, shape = 4, stroke = 2) +
  labs(title = "Distribución bivariante: Patrimonio vs. Deuda",
       x = "Patrimonio Neto", y = "Deuda Pendiente") +
  scale_color_manual(values = c("#00AFBB", "#E7B800"),
                     labels = c("Cumplidores", "Fallidos")) +
  theme_minimal()

Tras representar las distribuciones de patrimonio y deuda por grupo, observamos que la variable patrimonio presenta una buena capacidad discriminante: los clientes fallidos tienden a concentrarse en valores más bajos de patrimonio, mientras que los cumplidores muestran una clara concentración en niveles más altos. En cuanto a la deuda pendiente, las distribuciones presentan mayor solapamiento, aunque también se aprecia una ligera tendencia a que los cumplidores tengan menores niveles de deuda.

El gráfico bivariante refuerza esta percepción: ambos grupos se distribuyen de forma relativamente diferenciada en el plano Patrimonio-Deuda, y los centroides aparecen claramente separados. Esta estructura sugiere que un modelo lineal de clasificación como el Análisis Discriminante Lineal (LDA) puede resultar adecuado, ya que parece existir una frontera aproximadamente lineal entre los grupos y no se observan grandes diferencias en la dispersión interna.

A continuación, aplicamos el modelo de análisis discriminante lineal (LDA) con el objetivo de obtener la función discriminante que mejor separe los grupos de clientes fallidos y cumplidores. A partir del modelo estimado, calculamos las medias de los valores proyectados en la dimensión discriminante para cada grupo ({z}_0 y {z}_1) y determinamos el punto de corte óptimo. Este umbral nos permitirá clasificar nuevas observaciones según su distancia relativa a cada grupo.

# Aplicamos el modelo LDA
modelo_lda <- lda(Grupo ~ Patrimonio + Deuda, data = datos)

# Mostramos el modelo para ver los coeficientes de la función discriminante
modelo_lda

## Call:
## lda(Grupo ~ Patrimonio + Deuda, data = datos)
## 
## Prior probabilities of groups:
##   0   1 
## 0.5 0.5 
## 
## Group means:
##   Patrimonio Deuda
## 0          9     3
## 1          5     5
## 
## Coefficients of linear discriminants:
##                   LD1
## Patrimonio -0.4224919
## Deuda       0.3802226

# Obtenemos las puntuaciones discriminantes (valores proyectados en el eje LDA)
predicciones_entrenamiento <- predict(modelo_lda)

# Extraemos las puntuaciones discriminantes (LD1) para cada observación
z <- predicciones_entrenamiento$x[,1]

# Calculamos las medias discriminantes por grupo
z_barra <- tapply(z, datos$Grupo, mean)
z_barra

##         0         1 
## -1.225206  1.225206

# Calculamos el punto de corte como la media de los dos centroides
punto_corte <- mean(z_barra)
punto_corte

## [1] 0

Tras ajustar el modelo de análisis discriminante lineal (LDA) sobre los datos disponibles, obtenemos la siguiente función discriminante:

Z = -0.4225 · Patrimonio + 0.3802 · Deuda

Esta función proyecta las observaciones sobre una dimensión lineal que maximiza la separación entre los grupos de clientes cumplidores y fallidos. En este eje, hemos calculado los valores medios para cada grupo, obteniendo:

• {z}_0 = -1.2252 para el grupo 0 (cumplidores),

• {z}_1 = 1.2252 para el grupo 1 (fallidos).

El punto de corte óptimo se determina como la media de ambos centroides proyectados, resultando en un valor de 0. Este umbral será el que utilicemos para clasificar nuevas observaciones: aquellas con Z > 0 serán clasificadas como fallidas, y aquellas con Z < 0 como cumplidoras.

Antes de aplicar el modelo a nuevos solicitantes, evaluamos su capacidad de clasificación sobre la muestra original. Para ello, comparamos las predicciones obtenidas mediante la función discriminante con las clases reales y calculamos la tasa de acierto (eficiencia del modelo). Este indicador nos permite valorar si el modelo ha aprendido correctamente la separación entre grupos.

# Creamos una tabla de contingencia entre predicción y clase real
tabla_confusion <- table(Predicho = predicciones_entrenamiento$class,
                         Real = datos$Grupo)

# Calculamos la eficiencia: aciertos / total
eficiencia <- sum(diag(tabla_confusion)) / sum(tabla_confusion)
eficiencia

## [1] 0.9375

Para finalizar el análisis, representamos gráficamente la frontera de decisión generada por el modelo LDA mediante la función partimat() del paquete klaR. Esta herramienta permite visualizar de forma intuitiva cómo se separan los grupos en el espacio de las variables explicativas, y comprobar si la regla de decisión generada se ajusta adecuadamente a la estructura observada en los datos.

# Representamos la frontera de decisión
partimat(Grupo ~ Patrimonio + Deuda,
         data = datos,
         method = "lda",
         col.mean = c("blue", "orange"),
         col.correct = "gray80",
         col.wrong = "red",
         imageplot = FALSE)

Una vez formulada la función discriminante, estamos en disposición de aplicarla a nuevas observaciones. En este caso, el director de la entidad financiera nos proporciona dos nuevas solicitudes de préstamo, para las que se dispone de los valores de patrimonio neto y deuda pendiente en el momento de la solicitud. Utilizaremos la función discriminante obtenida para proyectar a cada uno de estos clientes y determinar si deberían ser clasificados como cumplidores o fallidos, basándonos en su posición relativa al punto de corte.

# Aplicamos el modelo LDA a los nuevos clientes
predicciones_nuevos <- predict(modelo_lda, newdata = nuevos)

# Mostramos las puntuaciones proyectadas y la clase predicha
predicciones_nuevos$x            # Valores de Z (proyección sobre LD1)

##          LD1
## 1 -0.2451015
## 2 -1.8251289

predicciones_nuevos$class        # Clasificación final según punto de corte

## [1] 0 0
## Levels: 0 1

# Creamos un resumen conjunto
resultado_nuevos <- nuevos %>%
  select(Patrimonio, Deuda) %>%
  mutate(Z = predicciones_nuevos$x[,1],
         Clasificacion = predicciones_nuevos$class)

resultado_nuevos

## # A tibble: 2 × 4
##   Patrimonio Deuda      Z Clasificacion
##        <dbl> <dbl>  <dbl> <fct>        
## 1       10.1   6.8 -0.245 0            
## 2        9.7   2.2 -1.83  0

Aplicamos la función discriminante obtenida a los dos nuevos solicitantes de préstamo. El primer cliente presenta un patrimonio de 10,1 y una deuda de 6,8, obteniendo una puntuación discriminante de Z = -0.2451. El segundo cliente tiene un patrimonio de 9,7 y una deuda de 2,2, con una puntuación de Z = -1.8251.

Ambos valores se encuentran por debajo del punto de corte establecido (0), por lo que ambos solicitantes han sido clasificados como cumplidores según el modelo. En consecuencia, la entidad financiera podría considerar conceder el préstamo a ambos perfiles, al presentar características similares a los clientes que anteriormente reintegraron el préstamo con éxito.

2.Análisis factorial

Comenzamos el análisis factorial cargando las librerías necesarias y leyendo el fichero Excel que contiene los datos de la encuesta de atención hospitalaria. Nos centramos en las variables P1 a P7, que son las que se analizarán a lo largo del ejercicio. Estas variables representan ítems relacionados con la percepción del usuario sobre el servicio recibido y serán la base del análisis factorial.

# Leemos el fichero Excel y seleccionamos solo las variables P1 a P7
datos <- read_excel("datos_atencion hospitalaria.xlsx")
datos_factorial <- datos %>%
  select(P1, P2, P3, P4, P5, P6, P7)
# Previsualización de las primeras filas del dataset
head(datos_factorial)

## # A tibble: 6 × 7
##      P1    P2    P3    P4    P5    P6    P7
##   <dbl> <dbl> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1     3     4     4     4     4     2     1
## 2     2     3     3     4     4     5     4
## 3     2     2     4     4     4     1     2
## 4     4     3     3     3     3     4     4
## 5     5     5     2     2     2     3     3
## 6     4     3     3     3     3     3     2

# Estadísticos descriptivos básicos
describe(datos_factorial)

##    vars   n mean   sd median trimmed  mad min max range  skew kurtosis   se
## P1    1 100 3.50 1.17    3.5    3.51 2.22   1   5     4 -0.06    -1.36 0.12
## P2    2 100 3.29 1.09    3.0    3.24 1.48   2   5     3  0.15    -1.36 0.11
## P3    3 100 2.91 1.32    3.0    2.89 1.48   1   5     4  0.09    -1.20 0.13
## P4    4 100 3.21 1.18    3.0    3.21 1.48   1   5     4 -0.01    -1.04 0.12
## P5    5 100 3.36 1.05    3.0    3.33 1.48   2   5     3  0.08    -1.24 0.10
## P6    6 100 3.32 1.30    3.0    3.34 1.48   1   5     4  0.00    -1.40 0.13
## P7    7 100 2.85 1.08    3.0    2.94 1.48   1   4     3 -0.18    -1.45 0.11

# Matriz de correlaciones
correl <- cor(datos_factorial, use = "pairwise.complete.obs")
correl

##             P1        P2           P3          P4          P5         P6
## P1  1.00000000 0.8258960 -0.088544771 -0.16449386 -0.15660073 0.16612267
## P2  0.82589602 1.0000000  0.291185482  0.24890683  0.19839108 0.28869518
## P3 -0.08854477 0.2911855  1.000000000  0.89261229  0.86291404 0.04047998
## P4 -0.16449386 0.2489068  0.892612288  1.00000000  0.90653011 0.07397738
## P5 -0.15660073 0.1983911  0.862914043  0.90653011  1.00000000 0.09966732
## P6  0.16612267 0.2886952  0.040479978  0.07397738  0.09966732 1.00000000
## P7  0.11649969 0.3201771  0.004624162  0.06462720  0.03039552 0.84182591
##             P7
## P1 0.116499690
## P2 0.320177069
## P3 0.004624162
## P4 0.064627196
## P5 0.030395525
## P6 0.841825907
## P7 1.000000000

# Visualización gráfica
if (!require("corrplot")) install.packages("corrplot")
library(corrplot)
corrplot(correl, type = "lower", method = "circle", tl.col = "black")

## Hacer un Análisis factorial con las variables P1, P2, P3, P4, P5, P6 y P7.

Antes de aplicar el análisis factorial, evaluamos si los datos cumplen las condiciones necesarias para su aplicación. Para ello, analizamos la matriz de correlaciones entre las variables, calculamos el índice KMO para valorar la adecuación de la muestra y aplicamos el test de esfericidad de Bartlett para comprobar si existen correlaciones significativas entre las variables. Si ambos indicadores son satisfactorios, podremos justificar la aplicación del análisis factorial.

# Matriz de correlaciones
correlaciones <- cor(datos_factorial, use = "pairwise.complete.obs")
correlaciones

##             P1        P2           P3          P4          P5         P6
## P1  1.00000000 0.8258960 -0.088544771 -0.16449386 -0.15660073 0.16612267
## P2  0.82589602 1.0000000  0.291185482  0.24890683  0.19839108 0.28869518
## P3 -0.08854477 0.2911855  1.000000000  0.89261229  0.86291404 0.04047998
## P4 -0.16449386 0.2489068  0.892612288  1.00000000  0.90653011 0.07397738
## P5 -0.15660073 0.1983911  0.862914043  0.90653011  1.00000000 0.09966732
## P6  0.16612267 0.2886952  0.040479978  0.07397738  0.09966732 1.00000000
## P7  0.11649969 0.3201771  0.004624162  0.06462720  0.03039552 0.84182591
##             P7
## P1 0.116499690
## P2 0.320177069
## P3 0.004624162
## P4 0.064627196
## P5 0.030395525
## P6 0.841825907
## P7 1.000000000

# Índice de adecuación de la muestra (KMO)
kmo_resultado <- KMO(datos_factorial)
kmo_resultado

## Kaiser-Meyer-Olkin factor adequacy
## Call: KMO(r = datos_factorial)
## Overall MSA =  0.58
## MSA for each item = 
##   P1   P2   P3   P4   P5   P6   P7 
## 0.39 0.45 0.82 0.70 0.76 0.49 0.42

# Test de esfericidad de Bartlett
bartlett_resultado <- cortest.bartlett(correlaciones, n = nrow(datos_factorial))
bartlett_resultado

## $chisq
## [1] 668.5095
## 
## $p.value
## [1] 5.914187e-128
## 
## $df
## [1] 21

Tras analizar la matriz de correlaciones entre las variables, observamos la existencia de relaciones moderadas y fuertes entre ciertos pares de ítems, como ocurre entre P3, P4 y P5, o entre P6 y P7, lo que sugiere la presencia de estructuras latentes comunes.

Sin embargo, el índice de adecuación muestral KMO presenta un valor global de 0.58, lo que indica que la muestra no es óptima para realizar un análisis factorial. Además, algunos ítems como P1, P2, P6 y P7 muestran índices individuales muy bajos (inferiores a 0.50), lo que sugiere que podrían no compartir suficiente varianza con el resto.

Por otro lado, el test de esfericidad de Bartlett arroja un valor de p < 0.001, indicando que la matriz de correlaciones no es una matriz identidad, por lo que existe correlación significativa entre las variables y, en principio, es factible aplicar un análisis factorial.

En conclusión, a pesar de que el índice KMO indica ciertas limitaciones en la adecuación de los datos, la existencia de correlaciones relevantes y la significación del test de Bartlett justifican la aplicación del análisis factorial, aunque los resultados deberán interpretarse con cautela.

Procedemos a realizar el análisis factorial sobre las 7 variables seleccionadas. En primer lugar, determinamos el número óptimo de factores a extraer mediante el criterio de Kaiser, el gráfico de sedimentación (Scree plot) y el análisis paralelo. A continuación, aplicamos el análisis factorial con rotación Varimax, que nos permitirá interpretar mejor los factores obtenidos.

# Análisis paralelo para decidir número de factores
fa.parallel(datos_factorial, fa = "fa", fm = "ml", n.iter = 100,
            show.legend = TRUE, main = "Análisis paralelo y Scree plot")

## Parallel analysis suggests that the number of factors =  3  and the number of components =  NA

Para determinar el número óptimo de factores, hemos aplicado el análisis paralelo con 100 iteraciones, comparando los autovalores reales con los generados aleatoriamente. Observamos que los tres primeros factores presentan autovalores superiores a los simulados, por lo que decidimos extraer tres factores. A continuación, aplicamos el análisis factorial con método de máxima verosimilitud y rotación Varimax para facilitar la interpretación.

# Análisis factorial con extracción de 3 factores, método ML + rotación Varimax
modelo_3f <- fa(datos_factorial, nfactors = 3, rotate = "varimax", fm = "ml")

# Matriz de cargas factoriales con corte en 0.3
print(modelo_3f$loadings, cutoff = 0.3)

## 
## Loadings:
##    ML3    ML2    ML1   
## P1         0.913       
## P2         0.942       
## P3  0.922              
## P4  0.973              
## P5  0.929              
## P6                0.837
## P7                0.992
## 
##                  ML3   ML2   ML1
## SS loadings    2.747 1.747 1.741
## Proportion Var 0.392 0.250 0.249
## Cumulative Var 0.392 0.642 0.891

# Comunalidades
round(modelo_3f$communality, 3)

##    P1    P2    P3    P4    P5    P6    P7 
## 0.861 0.995 0.856 0.950 0.866 0.713 0.995

# Especificidades
round(1 - modelo_3f$communality, 3)

##    P1    P2    P3    P4    P5    P6    P7 
## 0.139 0.005 0.144 0.050 0.134 0.287 0.005

# Varianza explicada
modelo_3f$Vaccounted

##                             ML3       ML2       ML1
## SS loadings           2.7474075 1.7472221 1.7405461
## Proportion Var        0.3924868 0.2496032 0.2486494
## Cumulative Var        0.3924868 0.6420899 0.8907394
## Proportion Explained  0.4406303 0.2802202 0.2791495
## Cumulative Proportion 0.4406303 0.7208505 1.0000000

** Varianza explicada:**

• Cada factor explica aproximadamente un 25–39% de la varianza.

• El modelo en conjunto explica el 89.1% de la varianza total → es un resultado excelente para un análisis factorial con 3 factores.

Tras aplicar el análisis factorial con tres factores, observamos una estructura muy clara en la que cada variable presenta una carga elevada sobre un único factor, sin solapamientos. Las comunalidades son en todos los casos superiores al umbral recomendado de 0.30, indicando que los factores explican adecuadamente la varianza de cada variable. Además, el modelo explica un 89.1% de la varianza total, lo que refuerza su solidez. En consecuencia, no se considera necesario eliminar ninguna variable.

# Comunalidades (h2) y especificidades (u2) a partir del modelo ML
comunalidades <- round(modelo_3f$communality, 3)
especificidades <- round(1 - comunalidades, 3)

# Creamos tabla unificada
tabla_comunalidad <- data.frame(
  Variable = names(comunalidades),
  Comunalidad = comunalidades,
  Especificidad = especificidades
)

# Mostramos la tabla
tabla_comunalidad

##    Variable Comunalidad Especificidad
## P1       P1       0.861         0.139
## P2       P2       0.995         0.005
## P3       P3       0.856         0.144
## P4       P4       0.950         0.050
## P5       P5       0.866         0.134
## P6       P6       0.713         0.287
## P7       P7       0.995         0.005

# Diagrama de factores basado en tu modelo ml
fa.diagram(modelo_3f)

# Biplot
biplot(modelo_3f)

# Extraemos las puntuaciones de los factores
scores <- modelo_3f$scores

# Mostramos primeras y últimas observaciones
head(scores)

##             ML3         ML2         ML1
## [1,]  0.8585680  0.85305373 -1.80391789
## [2,]  0.5571158 -0.71544690  1.14887752
## [3,]  0.7189065 -1.26539620 -0.68649075
## [4,] -0.2798159 -0.43973701  1.10685161
## [5,] -0.9786403  1.88819637 -0.04460811
## [6,] -0.1771920 -0.03179318 -0.78409191

tail(scores)

##               ML3        ML2        ML1
##  [95,]  1.4879602  1.7163924 -1.9016121
##  [96,] -1.2486257  0.7782054  1.0075690
##  [97,] -0.1073702 -1.2902640  0.2788824
##  [98,] -0.9504526 -0.8602266 -0.6977540
##  [99,]  1.2084496  1.0998792  0.9587105
## [100,]  0.2067775 -1.6150255  1.2340486

# Estadísticos descriptivos
summary(scores)

##       ML3               ML2                ML1         
##  Min.   :-1.7442   Min.   :-1.68023   Min.   :-1.9016  
##  1st Qu.:-0.8546   1st Qu.:-0.79911   1st Qu.:-0.7841  
##  Median :-0.1566   Median :-0.03179   Median : 0.1767  
##  Mean   : 0.0000   Mean   : 0.00000   Mean   : 0.0000  
##  3rd Qu.: 0.7204   3rd Qu.: 0.89992   3rd Qu.: 1.0076  
##  Max.   : 1.5782   Max.   : 1.88820   Max.   : 1.2340

# Correlaciones entre factores
library(corrplot)
corrplot(cor(scores), type = "lower", method = "circle", tl.col = "black")

# Histogramas individuales
hist(scores[,1], main = "Histograma ML1", xlab = "Puntuación", col = "red")

hist(scores[,2], main = "Histograma ML2", xlab = "Puntuación", col = "blue")

hist(scores[,3], main = "Histograma ML3", xlab = "Puntuación", col = "green")

# Puntuación ponderada por R² (Multiple R2)
# La matriz R2.scores representa la bondad de ajuste de cada factor
ponderacion <- as.matrix(scores) %*% as.matrix(modelo_3f$R2.scores)
colnames(ponderacion) <- "IndiceGlobal"

# Resumen y distribución de la puntuación compuesta
summary(ponderacion)

##   IndiceGlobal    
##  Min.   :-3.0353  
##  1st Qu.:-0.9834  
##  Median :-0.2180  
##  Mean   : 0.0000  
##  3rd Qu.: 1.2991  
##  Max.   : 3.4696

hist(ponderacion, main = "Histograma Índice Global", xlab = "Puntuación ponderada", col = "darkgreen")

3.Escalamiento Multidimensional

En este ejercicio vamos a aplicar técnicas de escalamiento multidimensional no métrico con el objetivo de analizar la similitud en la evolución de las tasas de paro registradas en la provincia de Cantabria desde 2005 hasta el primer trimestre de 2020.

El análisis nos permitirá representar gráficamente la proximidad entre las series temporales, facilitando la interpretación de patrones comunes.

Finalmente, aplicaremos técnicas de clustering para agrupar aquellas series que compartan comportamientos similares a lo largo del tiempo.

Cargamos el fichero Excel con los datos de paro para la provincia de Cantabria. Inspeccionamos su estructura para identificar las columnas que contienen las tasas de paro y determinar si es necesario transformar el formato para aplicar el escalamiento multidimensional.

# Cargar el archivo Excel
ruta_archivo <- "datos_socioecconomica.xlsx"
datos_paro <- read_excel('/Users/oscar/Desktop/BIG DATA/2o TRIMESTRE/MODULO 4_Análisis de datos multivariantes 2/3_Autoevaluación/M04_Autoevalucion_OscarPorta/datos_socioeconomica.xlsx')

# Ver estructura y primeras filas
str(datos_paro)

## tibble [61 × 18] (S3: tbl_df/tbl/data.frame)
##  $ Ano                           : num [1:61] 2005 2005 2005 2005 2006 ...
##  $ Trimestre                     : num [1:61] 1 2 3 4 1 2 3 4 1 2 ...
##  $ Hombres.16-24                 : num [1:61] 16.1 13.3 12.9 15.4 13.6 ...
##  $ Hombres.25-54                 : num [1:61] 6.09 5.55 5.19 4.91 3.97 ...
##  $ Hombres.55-64                 : num [1:61] 4.31 4.71 4.94 6.48 4.53 ...
##  $ Hombres.Total                 : num [1:61] 6.92 6.15 5.99 6.08 4.91 ...
##  $ Mujeres.16-24                 : num [1:61] 26.1 24.9 16.3 23.4 22.7 ...
##  $ Mujeres.25-54                 : num [1:61] 13.75 12.85 8.23 9.91 9.16 ...
##  $ Mujeres.55-64                 : num [1:61] 5.82 4.19 3.36 2.13 3.36 ...
##  $ Mujeres.Total                 : num [1:61] 14.28 13.4 8.69 10.73 10.1 ...
##  $ Total.16-24                   : num [1:61] 19.9 18.8 14.3 19 17.7 ...
##  $ Total.25-54                   : num [1:61] 9.28 8.54 6.45 7.03 6.2 ...
##  $ Total.55-64                   : num [1:61] 4.8 4.51 4.36 4.91 4.13 ...
##  $ Total.Total                   : num [1:61] 9.89 9.15 7.1 8.04 7.11 ...
##  $ Total.Jovenes                 : num [1:61] 17.1 15.3 10.9 14.7 11.9 ...
##  $ Total.No cualificadas         : num [1:61] 9.51 6.76 6.77 8.25 9.3 ...
##  $ Parados Larga Duracion.16-67  : num [1:61] 9085 7245 6191 6080 4836 ...
##  $ Parados Larga Duracion.Jovenes: num [1:61] 2968 2912 1373 1953 1468 ...

head(datos_paro)

## # A tibble: 6 × 18
##     Ano Trimestre `Hombres.16-24` `Hombres.25-54` `Hombres.55-64` Hombres.Total
##   <dbl>     <dbl>           <dbl>           <dbl>           <dbl>         <dbl>
## 1  2005         1           16.1             6.09            4.31          6.92
## 2  2005         2           13.3             5.55            4.71          6.15
## 3  2005         3           12.9             5.19            4.94          5.99
## 4  2005         4           15.4             4.91            6.48          6.08
## 5  2006         1           13.6             3.97            4.53          4.91
## 6  2006         2            9.92            2.87            5.58          3.81
## # ℹ 12 more variables: `Mujeres.16-24` <dbl>, `Mujeres.25-54` <dbl>,
## #   `Mujeres.55-64` <dbl>, Mujeres.Total <dbl>, `Total.16-24` <dbl>,
## #   `Total.25-54` <dbl>, `Total.55-64` <dbl>, Total.Total <dbl>,
## #   Total.Jovenes <dbl>, `Total.No cualificadas` <dbl>,
## #   `Parados Larga Duracion.16-67` <dbl>,
## #   `Parados Larga Duracion.Jovenes` <dbl>

Seleccionamos las columnas del dataset que contienen las tasas de paro para los diferentes grupos de edad y sexo. A continuación, calculamos la similitud entre las series temporales mediante la distancia Dynamic Time Warping (DTW), que permite comparar secuencias temporales que puedan estar desfasadas en el tiempo. Finalmente, visualizamos la matriz de distancias mediante un mapa de calor con dendrograma, que permite identificar visualmente los grupos de series más similares.

# Seleccionamos únicamente las columnas con tasas de paro
datos_eval <- datos_paro[ , 3:(ncol(datos_paro) - 2)]

# Calculamos la matriz de distancias DTW entre columnas (series temporales)
# NOTA: by_rows = FALSE indica que la comparación se hace por columnas (series)
distMatrix <- proxy::dist(datos_eval, method = "DTW", by_rows = FALSE)

# Representamos la matriz de distancias como un mapa de calor con dendrograma
heatmap(as.matrix(distMatrix), margins = c(10, 10), main = "Mapa de Calor: Similitud entre series de paro (DTW)")

En el siguiente mapa de calor representamos la matriz de distancias DTW entre las distintas series de paro. Las celdas más claras indican mayor similitud entre la evolución temporal de las tasas de paro para los diferentes grupos, mientras que las oscuras representan trayectorias más divergentes. A través del dendrograma se identifican grupos coherentes, como los relacionados con los jóvenes (16–24 años), que muestran un comportamiento diferenciado respecto al resto de la población. Esta visualización resulta útil para explorar posibles patrones de agrupación de comportamiento a lo largo del tiempo.

Una vez obtenida la matriz de distancias entre las series temporales de paro mediante DTW, aplicamos un escalamiento multidimensional no métrico (NMDS) con el objetivo de representar estas distancias en un espacio bidimensional. Esta técnica permite conservar la estructura ordinal de las similitudes y visualizarla gráficamente. Evaluamos el ajuste del modelo a través del índice de stress, que indica el grado de distorsión entre las distancias originales y las proyectadas.

# Aplicamos el escalamiento multidimensional no métrico (NMDS)
socioeconomica_smacof <- mds(distMatrix, type = "ordinal")

# Mostramos el stress del modelo (debería ser bajo si el ajuste es bueno)
paste("Stress(%) = ", round(socioeconomica_smacof$stress * 100, 3))

## [1] "Stress(%) =  0.536"

# Gráfico de configuración
plot(socioeconomica_smacof, plot.type = "confplot", main = "Configuración NMDS - Series de Paro")

Con el fin de evaluar la calidad del ajuste del modelo NMDS, representamos dos gráficos: el stress plot y el gráfico de Shepard. Ambos permiten comprobar la fidelidad con la que las distancias originales han sido representadas en el espacio bidimensional. A continuación, aplicamos técnicas de agrupamiento (clustering) sobre las coordenadas obtenidas, utilizando un algoritmo jerárquico. Para determinar el número óptimo de grupos, analizamos la evolución del error intragrupo en un modelo k-means.

# Gráfico de stress: representación del ajuste del modelo
plot(socioeconomica_smacof, plot.type = "stressplot", main = "Stress Plot")

# Shepard diagram: comparación entre distancias originales y representadas
plot(socioeconomica_smacof, plot.type = "Shepard", main = "Shepard Diagram")

# Creamos matriz de distancias entre los puntos de la configuración (coordenadas NMDS)
d <- dist(socioeconomica_smacof$conf)^2

# Selección del número óptimo de clústers (codo del error intragrupo)
set.seed(123)
Errores <- NULL
K_Max <- 10

for (i in 1:K_Max) {
  Errores[i] <- sum(kmeans(d[-1], centers = i)$withinss)
}

# Visualización del "codo"
err_df <- data.frame(
  num_cl = 1:K_Max,
  sum_err = Errores
)

library(ggplot2)
ggplot(err_df, aes(x = as.factor(num_cl), y = sum_err)) +
  geom_line(group = 1) +
  geom_point() +
  labs(
    title = "GRÁFICO SELECCIÓN NÚMERO DE CLÚSTERS",
    x = "Número de clústers",
    y = "Suma del Error"
  ) +
  theme_bw()

# Agrupamiento jerárquico con enlace promedio
hc <- hclust(d, method = "average")

# Representamos el dendrograma
plot(hc, main = "Dendrograma - Clustering jerárquico sobre configuración NMDS")

El análisis del gráfico de codo sugiere que la partición óptima es de dos clústers, lo cual resulta coherente con la representación NMDS previa. Para realizar el agrupamiento final, optamos por un método jerárquico con enlace promedio, adecuado en este caso ya que estamos agrupando variables (series) y no observaciones. El dendrograma resultante confirma la existencia de dos grupos diferenciados de evolución en las tasas de paro, en línea con la diferenciación observada previamente entre jóvenes y población adulta.

Una vez identificado que existen dos grandes agrupaciones en la evolución de las tasas de paro, representamos gráficamente las series temporales que pertenecen a cada uno de estos grupos. En el primer grupo se encuentran las tasas correspondientes a la población joven, caracterizadas por una mayor variabilidad y valores más elevados. En el segundo grupo agrupamos el resto de tasas, asociadas a una evolución más estable y menos extrema.

# Series correspondientes a población joven
young_cols <- c("Total.Jovenes", "Mujeres.16-24", "Hombres.16-24", "Total.16-24")

young_data <- datos_eval %>%
  select(all_of(young_cols))

young_data$idx <- 1:nrow(young_data)

youngdat <- young_data %>%
  pivot_longer(cols = -idx) %>%
  ggplot(aes(x = idx, y = value, group = name)) +
  geom_line(col = "green4") +
  facet_wrap(~ name, ncol = 2) +
  labs(
    title = "Tasa de Paro - Jóvenes",
    x = "Periodo",
    y = "Tasa de Paro"
  ) +
  theme_bw()

print(youngdat)

# Series correspondientes al resto de variables
resto_cols <- setdiff(names(datos_eval), young_cols)

resto_data <- datos_eval %>%
  select(all_of(resto_cols))

resto_data$idx <- 1:nrow(resto_data)

restodat <- resto_data %>%
  pivot_longer(cols = -idx) %>%
  ggplot(aes(x = idx, y = value, group = name)) +
  geom_line(col = "green4") +
  facet_wrap(~ name, ncol = 2) +
  labs(
    title = "Tasa de Paro - Resto Tasas",
    x = "Periodo",
    y = "Tasa de Paro"
  ) +
  theme_bw()

print(restodat)

Como paso final, representamos gráficamente las series temporales agrupadas por los clústers obtenidos en el modelo NMDS.

• En el primer grupo se encuentran las tasas de paro correspondientes a la población joven, que presentan niveles de paro significativamente más elevados y una mayor volatilidad a lo largo del tiempo.

• En cambio, el segundo grupo, que agrupa al resto de categorías poblacionales, muestra una evolución más moderada y estable en las tasas de desempleo.

Esta clasificación permite identificar dinámicas diferenciadas en el mercado laboral y puede ser útil para diseñar políticas específicas según el segmento poblacional afectado.

4. Correlación canónica

En este ejercicio vamos a aplicar un análisis de correlación canónica sobre el conjunto de datos Cars93, disponible en la librería MASS.

Nuestro objetivo es estudiar las relaciones entre dos grupos de variables:

• por un lado, las características físicas de los automóviles (como el tamaño del motor, la longitud o el peso)

• por otro, variables relacionadas con el precio y el rendimiento (precio medio, consumo en ciudad y carretera, y radio de giro).

El análisis nos permitirá identificar combinaciones lineales de variables que están altamente correlacionadas entre ambos grupos.

Comenzamos seleccionando los dos conjuntos de variables que van a formar parte del análisis. Por un lado, incluimos las variables relacionadas con el precio y el rendimiento del vehículo (grupo X): precio medio, consumo en ciudad, consumo en carretera y radio de giro. Por otro lado, seleccionamos las características físicas del vehículo (grupo Y): tamaño del motor, caballos de fuerza, longitud, distancia entre ejes, anchura, espacio del asiento trasero y peso. A continuación, visualizamos la matriz de correlación entre ambos bloques de variables para estudiar el patrón de relaciones antes de aplicar el análisis canónico.

# Seleccionamos los datos
datos4 <- Cars93

# Definimos las matrices de variables
X <- as.matrix(datos4[, c("Price", "MPG.city", "MPG.highway", "Turn.circle")])
Y <- as.matrix(datos4[, c("EngineSize", "Horsepower", "Length", "Wheelbase", "Width", "Rear.seat.room", "Weight")])

# Calculamos la matriz de correlaciones cruzadas
correl <- matcor(X, Y)

# Mostramos la matriz
correl

## $Xcor
##                  Price   MPG.city MPG.highway Turn.circle
## Price        1.0000000 -0.5945622  -0.5606804   0.3925899
## MPG.city    -0.5945622  1.0000000   0.9439358  -0.6663889
## MPG.highway -0.5606804  0.9439358   1.0000000  -0.5936833
## Turn.circle  0.3925899 -0.6663889  -0.5936833   1.0000000
## 
## $Ycor
##                EngineSize Horsepower    Length Wheelbase     Width
## EngineSize      1.0000000  0.7321197 0.7802831 0.7324842 0.8671102
## Horsepower      0.7321197  1.0000000 0.5508647 0.4868542 0.6444134
## Length          0.7802831  0.5508647 1.0000000 0.8236504 0.8221479
## Wheelbase       0.7324842  0.4868542 0.8236504 1.0000000 0.8072134
## Width           0.8671102  0.6444134 0.8221479 0.8072134 1.0000000
## Rear.seat.room  0.5027498  0.2567315 0.5499578 0.6672586 0.4656176
## Weight          0.8450753  0.7387975 0.8062743 0.8718953 0.8749605
##                Rear.seat.room    Weight
## EngineSize          0.5027498 0.8450753
## Horsepower          0.2567315 0.7387975
## Length              0.5499578 0.8062743
## Wheelbase           0.6672586 0.8718953
## Width               0.4656176 0.8749605
## Rear.seat.room      1.0000000 0.5262505
## Weight              0.5262505 1.0000000
## 
## $XYcor
##                     Price   MPG.city MPG.highway Turn.circle EngineSize
## Price           1.0000000 -0.5945622  -0.5606804   0.3925899  0.5974254
## MPG.city       -0.5945622  1.0000000   0.9439358  -0.6663889 -0.7100032
## MPG.highway    -0.5606804  0.9439358   1.0000000  -0.5936833 -0.6267946
## Turn.circle     0.3925899 -0.6663889  -0.5936833   1.0000000  0.7784636
## EngineSize      0.5974254 -0.7100032  -0.6267946   0.7784636  1.0000000
## Horsepower      0.7882176 -0.6726362  -0.6190437   0.5612157  0.7321197
## Length          0.5036284 -0.6662390  -0.5428974   0.7389545  0.7802831
## Wheelbase       0.5008642 -0.6671076  -0.6153842   0.7233244  0.7324842
## Width           0.4560279 -0.7205344  -0.6403592   0.8178542  0.8671102
## Rear.seat.room  0.3114988 -0.3843469  -0.3666844   0.4663276  0.5027498
## Weight          0.6471790 -0.8431385  -0.8106581   0.7780431  0.8450753
##                Horsepower     Length  Wheelbase      Width Rear.seat.room
## Price           0.7882176  0.5036284  0.5008642  0.4560279      0.3114988
## MPG.city       -0.6726362 -0.6662390 -0.6671076 -0.7205344     -0.3843469
## MPG.highway    -0.6190437 -0.5428974 -0.6153842 -0.6403592     -0.3666844
## Turn.circle     0.5612157  0.7389545  0.7233244  0.8178542      0.4663276
## EngineSize      0.7321197  0.7802831  0.7324842  0.8671102      0.5027498
## Horsepower      1.0000000  0.5508647  0.4868542  0.6444134      0.2567315
## Length          0.5508647  1.0000000  0.8236504  0.8221479      0.5499578
## Wheelbase       0.4868542  0.8236504  1.0000000  0.8072134      0.6672586
## Width           0.6444134  0.8221479  0.8072134  1.0000000      0.4656176
## Rear.seat.room  0.2567315  0.5499578  0.6672586  0.4656176      1.0000000
## Weight          0.7387975  0.8062743  0.8718953  0.8749605      0.5262505
##                    Weight
## Price           0.6471790
## MPG.city       -0.8431385
## MPG.highway    -0.8106581
## Turn.circle     0.7780431
## EngineSize      0.8450753
## Horsepower      0.7387975
## Length          0.8062743
## Wheelbase       0.8718953
## Width           0.8749605
## Rear.seat.room  0.5262505
## Weight          1.0000000

Hemos calculado las matrices de correlación entre las variables del conjunto X (relacionadas con el precio y el funcionamiento del vehículo) y las del conjunto Y (asociadas a sus características físicas).

En la matriz de correlaciones internas de X ($Xcor), observamos que las variables de consumo en ciudad y carretera (MPG.city y MPG.highway) están fuertemente correlacionadas positivamente entre sí y negativamente con el precio y el radio de giro. Esto indica que los coches más caros y menos maniobrables tienden a consumir más combustible (es decir, tienen menor eficiencia).

En la matriz interna de Y ($Ycor), las variables físicas como longitud, peso, tamaño del motor y distancia entre ejes muestran correlaciones altas entre sí, lo que sugiere que los vehículos más grandes también tienden a ser más pesados y potentes.

La matriz de correlación cruzada ($XYcor) muestra cómo se relacionan las variables de X con las de Y. Observamos que el precio y el radio de giro están positivamente correlacionados con casi todas las variables físicas, mientras que el consumo (MPG) está negativamente correlacionado. Esto confirma que los coches más grandes, pesados y potentes tienden a ser más caros, menos maniobrables y menos eficientes.

A continuación, representamos gráficamente las correlaciones entre los dos grupos de variables mediante una matriz cruzada, lo que nos permite observar las asociaciones individuales entre cada par de variables. Luego aplicamos el análisis de correlación canónica (CCA), con el que obtenemos combinaciones lineales óptimas de variables en X e Y que maximizan su correlación mutua.

# Representamos la matriz de correlaciones cruzadas con colores
img.matcor(correl, type = 2)

# Ejecutamos el análisis de correlación canónica
res.cc <- cc(X, Y)

# Mostramos los resultados
res.cc

## $cor
## [1] 0.9318169 0.6663061 0.6271609 0.2633357
## 
## $names
## $names$Xnames
## [1] "Price"       "MPG.city"    "MPG.highway" "Turn.circle"
## 
## $names$Ynames
## [1] "EngineSize"     "Horsepower"     "Length"         "Wheelbase"     
## [5] "Width"          "Rear.seat.room" "Weight"        
## 
## $names$ind.names
##  [1] "1"  "2"  "3"  "4"  "5"  "6"  "7"  "8"  "9"  "10" "11" "12" "13" "14" "15"
## [16] "16" "17" "18" "19" "20" "21" "22" "23" "24" "25" "26" "27" "28" "29" "30"
## [31] "31" "32" "33" "34" "35" "36" "37" "38" "39" "40" "41" "42" "43" "44" "45"
## [46] "46" "47" "48" "49" "50" "51" "52" "53" "54" "55" "56" "57" "58" "59" "60"
## [61] "61" "62" "63" "64" "65" "66" "67" "68" "69" "70" "71" "72" "73" "74" "75"
## [76] "76" "77" "78" "79" "80" "81" "82" "83" "84" "85" "86" "87" "88" "89" "90"
## [91] "91" "92" "93"
## 
## 
## $xcoef
##                    [,1]        [,2]        [,3]        [,4]
## Price       -0.04310858  0.10925900  0.03358494 -0.04068036
## MPG.city     0.05517547  0.07097054 -0.28203869 -0.52525853
## MPG.highway  0.01228722 -0.01381975  0.46364713  0.33802420
## Turn.circle -0.12724047 -0.20762282  0.14786895 -0.30923665
## 
## $ycoef
##                        [,1]          [,2]         [,3]         [,4]
## EngineSize     -0.142930393  0.0179710876  0.505788513 -0.760826208
## Horsepower     -0.005992437  0.0238236468  0.012087912 -0.005531174
## Length         -0.008170011  0.0011923864  0.067773848  0.108421267
## Wheelbase      -0.001044217  0.0905265364  0.114569374 -0.202832295
## Width           0.036172528 -0.3824806380  0.067615186 -0.109812878
## Rear.seat.room -0.003914288 -0.0077759502 -0.043902482 -0.169822635
## Weight         -0.001056177 -0.0006514885 -0.004547599  0.002433563
## 
## $scores
## $scores$xscores
##            [,1]        [,2]        [,3]         [,4]
## 1   0.573488474  0.17244058 -0.26620325  0.015241273
## 2  -0.789657912  1.51760447 -0.32141735  0.622422521
## 3  -0.332858131  1.32890543 -0.73092425  0.414432075
## 4  -0.758767346  2.19756228 -0.16005509  0.589839466
## 5  -0.466636995  1.09865496  0.88555123  0.060926204
## 6  -0.092378093 -0.89281412  1.16467162  0.362206315
## 7  -0.641860344 -0.71466842  0.93899844  0.407202772
## 8  -1.350984671 -1.19213816  0.93517629 -0.076777274
## 9  -0.764004254  0.10769865  0.51219953  0.154673216
## 10 -1.570698059  0.42495648  1.00887272  0.094212021
## 11 -1.930724837  0.80733226  1.33810034 -0.434698599
## 12  0.615455519 -0.37742848  2.11593899  1.497826548
## 13  0.549857768 -0.77592980  1.26934380  0.593902219
## 14 -0.523381935 -1.54506754  0.89543323  0.329844197
## 15 -0.053509235 -0.70667054  0.37826409  0.512517013
## 16 -0.818964241 -1.62345136 -0.95259285 -1.193071383
## 17 -0.779803917 -1.34688038 -1.78308058 -0.025099220
## 18 -0.690568557 -1.04748800  0.50861168  0.863032145
## 19 -1.657780891  0.85648172  0.83766433 -0.565291708
## 20 -0.228743355 -0.49067383  0.28061800  0.598050425
## 21 -0.078375131 -0.76945844 -0.50494996 -1.181192857
## 22 -1.240784856 -0.08075073  0.31759236 -1.766496635
## 23  1.743794579  0.73476206 -1.43142759  0.408997279
## 24  0.509622086 -0.65207522 -0.63604191  0.267602943
## 25  0.216414567 -0.68451108 -1.06625865 -0.273784319
## 26 -0.760626350 -0.95653745 -1.80290698 -0.835224943
## 27 -0.319632035 -1.12705439 -0.26336775 -0.769800588
## 28 -0.707246608  0.23118068 -0.76136459 -0.004564034
## 29  1.105506970  0.23204776 -0.73919698 -0.949990423
## 30 -0.267541073 -0.39234073  0.31084444  0.561438097
## 31  1.804500477  0.47241411 -1.90808891 -0.877531768
## 32  0.828120534 -0.38176012 -0.50843460  1.272916887
## 33  0.302631718 -0.90302908 -1.13342853 -0.192423590
## 34  0.001666231 -0.63570000  0.09622540 -0.012741512
## 35  0.460691614 -0.29992513 -0.36375413 -0.029468364
## 36 -1.303783629 -1.60919415 -1.22864344 -1.087054379
## 37 -0.226588894 -0.25067659  0.98632646  0.675615649
## 38 -0.853161570 -0.95469638  0.44497031 -0.056891798
## 39  2.670666091  1.20367264  1.92478584 -3.359915216
## 40  1.057371040  0.08671394  0.52765015 -0.782617100
## 41  0.095708622  0.11233450  0.44255460 -0.236626927
## 42  1.986832693  0.96408214  1.61835425 -3.379968578
## 43 -0.059622596 -0.55420685  0.66104713 -0.761535392
## 44  1.413803457 -0.01921721 -1.02812267 -0.469896240
## 45  0.764968709 -0.44983681 -0.69340153  1.464219246
## 46  1.301587594  0.18019225  0.20094146  1.671779463
## 47 -0.174282452 -1.17614240 -0.18629241  0.133851210
## 48 -1.994176963  2.18722788 -0.36865510 -1.672863273
## 49 -0.802085474  0.47155048 -0.68747772 -0.094060836
## 50 -0.997513962  1.47965785 -1.05718224 -0.415747011
## 51 -1.358751476  0.64602650  1.02917824  0.232486496
## 52 -1.762892857  0.29079477  1.25119928 -1.293706642
## 53  1.577260218  0.16590432  0.68867238  1.179233116
## 54  1.113058296  0.05406258  0.91363214  0.613748931
## 55  0.257939029 -0.35536119  1.30645725 -0.448062818
## 56 -0.291178682 -0.29323179 -1.13425263  0.577231060
## 57 -0.657240902  1.50129416 -0.23426652  1.513870209
## 58 -0.034979083  2.21623985  0.31044812  2.242309620
## 59 -1.814282086  4.85544982  0.18905331 -0.732649558
## 60  0.606537370  0.11055487 -2.22868336 -0.241901383
## 61  0.096867702 -0.50116573 -0.77792275  1.208115124
## 62  1.187413263  0.02445567 -0.80300836 -0.872697730
## 63 -1.101900593 -0.35891009 -0.30768226 -0.944478099
## 64  1.504471813  0.81121263 -1.19623780 -0.006008321
## 65  0.132926095 -0.52943047 -0.01092184 -0.717098288
## 66 -0.613122306 -0.76562823 -1.02012317  0.145992079
## 67 -0.459019375 -0.26098372 -0.67673269 -1.038602289
## 68  0.367292647 -0.57599720  0.23096948  0.019659369
## 69 -0.190308243 -0.96391101  1.05065284 -0.496697081
## 70 -0.956911682 -1.27382256 -0.84512104 -1.323248549
## 71 -0.637549487 -0.72559432  0.93563994  0.411270808
## 72  0.261032247 -0.53481489  0.07958748  0.170281364
## 73  1.579343539  0.12142488  2.15056193  1.143099970
## 74  0.415577761 -0.90918934  0.43240431  0.642550770
## 75 -0.635464231 -1.26099414  0.98275407  0.224075249
## 76 -0.427757366 -0.74452154  0.25023700  0.471980059
## 77 -0.924291686 -0.52895884  1.20777317 -0.048483193
## 78 -0.315614701  1.28520183 -0.74435823  0.430704220
## 79  0.650225131 -0.85869770  2.41560972  0.073190912
## 80  2.048132167  0.87595802 -0.73186178 -0.307395719
## 81  1.031225077  0.05521098 -1.19351298  0.499092196
## 82  0.295659454  0.43765165 -0.04486722  0.581284809
## 83  2.189805602  0.82546891  0.66024374 -2.057411031
## 84  1.423642812  0.12745879  0.18867162 -1.076036312
## 85  0.223523309  0.01652269  0.57714412 -0.366908739
## 86  0.156997449  0.03084134 -0.12226714  0.512166953
## 87 -0.725424926 -0.28750554 -1.64490321 -0.863739962
## 88  1.272922630  0.02470836 -0.01089343  1.895626114
## 89 -0.281840470 -0.04956487 -2.37087331  0.373245410
## 90  0.418235175  0.76558572  0.24026473  2.229934982
## 91 -0.078226071  0.77470472 -0.97315560  1.672107689
## 92  0.022786649  0.67297887 -0.30061230  0.825576288
## 93 -0.332063590  0.83142151  0.26363510  0.878876704
## 
## $scores$yscores
##           [,1]         [,2]        [,3]         [,4]
## 1   0.54367677  0.486074996  0.50975610 -0.114911768
## 2  -0.98482076  1.407280844  0.81345545 -1.040297731
## 3  -0.56520418  1.204299354 -1.57468101  0.758094139
## 4  -0.61050178  0.391592104 -0.30063335  0.590341776
## 5  -1.14094034  1.785540694 -0.60281644 -0.147813952
## 6   0.41057508 -0.443712777  0.71236005  0.500577915
## 7  -0.72586270 -0.745486044  1.22506118 -0.610793310
## 8  -1.71927834 -1.945011398  1.34690218 -0.285035292
## 9  -0.75330983 -0.622153200  0.74011012  0.630803522
## 10 -1.32722534  0.517491070  1.94710089 -1.860961222
## 11 -2.11502116  1.944786090  1.27519154 -0.430470640
## 12  0.78707632  0.610684654  1.48209118  0.442775342
## 13  0.52550643 -0.170803836  0.59656376  0.582405867
## 14 -0.27668464 -1.711912934  0.56916744  1.392528078
## 15  0.07160450 -1.135469820  0.34681819  1.329907587
## 16 -0.80384161 -1.021859766 -1.49469465 -2.197006057
## 17 -1.17157663 -2.777599576 -1.37429146 -1.212170315
## 18 -1.36926640 -1.680915553  1.59949254 -0.108896940
## 19 -1.48370546  1.082193259  1.14221454 -1.775316112
## 20 -0.62860964 -1.008048309  0.97253950 -0.192152039
## 21 -0.10194504  0.441001907 -0.13912555 -0.543108123
## 22 -0.84804618  0.415121772 -0.25140239  0.283329047
## 23  1.28997171  0.019824095  0.95917599  0.025923835
## 24  0.81501397 -0.679759846 -0.67622569  0.337416243
## 25  0.35301046 -0.472216750 -0.50019800 -0.432619127
## 26 -0.54541359 -0.723242871 -2.12611425 -1.289819946
## 27  0.18208919 -0.822718336 -0.07273702  0.715061528
## 28 -1.59758031  1.674352033 -1.76528929  2.768048733
## 29  1.26356728  0.003536883  0.84548601  0.086762900
## 30 -0.98424567  0.471659139  1.90087846 -0.681156582
## 31  2.11261733 -0.010004420 -0.89378780 -2.236664506
## 32  0.81756240  0.291934325  0.15005360 -0.452999465
## 33  0.74989562 -0.732236614  0.02595498 -0.052614707
## 34  0.51512112 -0.500742433 -0.12132008  1.003785475
## 35  0.72828157 -0.754013539  0.82498413  0.272133856
## 36 -0.62425574 -0.063654270 -1.51017771 -3.139190607
## 37 -0.30479316 -0.671508494 -0.06898088  0.796634165
## 38 -1.42154623 -1.807497051  1.13800891  0.176250431
## 39  2.27115830  0.163577904  0.49550510 -2.108219808
## 40  1.19789269 -0.628960372 -0.58356652 -0.191764089
## 41  0.28589089 -0.057775956  0.17904410  0.262085873
## 42  1.17880320  0.263237215  1.22308167 -1.321832466
## 43  0.02006020  1.108003268  0.17019453  0.104288815
## 44  1.22331174  0.490971767 -0.56067588  0.844435469
## 45  0.69614124  0.545502443 -0.29533540  0.000848837
## 46  1.28306381  0.426695657 -0.11302920  0.735479975
## 47  0.35616781 -0.141555114  0.22090071 -0.283392106
## 48 -2.10143306  2.452436936  0.63414218 -0.382255128
## 49 -0.77020541  0.386161721 -1.04874938  1.282565118
## 50 -0.99686822  1.247966156  0.13643016  1.104996605
## 51 -0.97655515 -0.919029953  0.14503879  1.134565137
## 52 -1.75466024 -0.748687381  1.58692539  0.326681941
## 53  1.35830049 -0.358785508 -0.17550133 -0.827292800
## 54  1.01796572  0.174137717  0.33524002 -0.066303830
## 55 -0.01388452  0.590842580  0.47369822 -0.198508399
## 56 -0.77937660 -0.604023345 -1.36183288  0.573442637
## 57 -0.17206875  2.147507619 -0.43743977  0.105795874
## 58  0.28404989  0.772317493 -0.17346611 -0.547412395
## 59 -1.03974703  2.161202290  0.05955534 -0.343617382
## 60  1.09930468  0.254624010 -0.33635519  1.468242478
## 61 -0.71425959 -0.969622639  0.42926585 -0.083875721
## 62  1.31803698 -0.377440553  0.79950474 -0.154981195
## 63 -1.12495267  1.012327164 -1.24990150  1.129432293
## 64  0.91409175  0.089352863 -0.50153541  0.576400641
## 65 -0.04411226  0.972555402 -0.40456877  0.213880253
## 66 -1.06869768 -1.517131464 -2.68373786  0.943438658
## 67 -0.33411065  0.457763212  0.06186026  0.403598003
## 68  0.03285044  1.193319598  0.73832400  0.765468428
## 69  0.42801583 -0.831515914  0.80227309  0.523521931
## 70 -0.93456178 -1.002781583 -0.41031308 -0.462265780
## 71 -0.73794700 -0.752069608  1.24893255 -0.672194678
## 72  0.90952244 -0.674482986 -0.59862222  1.022337558
## 73  1.27740842 -0.357443873  0.79015789  0.536341494
## 74  0.73405737  0.550521527  0.92661370  0.693372138
## 75 -0.26502214 -2.090816413  0.84010417  1.607979002
## 76 -0.84787390  0.478036329  0.74633235  0.104592278
## 77 -0.56435688 -0.789198145 -0.44742730 -3.043643394
## 78  0.33663531  0.565109861  0.40625434  1.304448386
## 79  1.08893496 -0.686808268  0.78272176 -0.506249243
## 80  1.71616868  1.268980960 -1.48722748 -0.433079544
## 81  0.97950592  0.119611194 -0.07204829  0.595365900
## 82  0.09061204  0.388438767 -1.09091404  0.802567375
## 83  1.77152473  0.362345900  0.27844704 -0.678160699
## 84  1.65280432 -0.052836614  0.58660804 -0.397336952
## 85  0.33521866 -0.415891068 -0.78828565  0.972435885
## 86  0.17677362 -0.633577190  0.02072976  0.857507957
## 87 -0.68870808 -0.460218956 -2.35467767 -0.851971122
## 88  1.33322547  0.468280918 -0.38488003  0.021389490
## 89 -0.67605303 -1.456969708 -3.10982171 -0.687431077
## 90  0.17401755  0.602015134 -0.70417812 -0.169361224
## 91  0.14402854  1.635691982 -0.90866790 -1.463282773
## 92  0.17607143  0.248935826  0.08591301  0.934040039
## 93 -0.31805548  0.682345817 -0.57193125  0.034103338
## 
## $scores$corr.X.xscores
##                   [,1]       [,2]       [,3]        [,4]
## Price       -0.7985077  0.5968262 0.06788744 -0.03969063
## MPG.city     0.8927990  0.1477631 0.23794477 -0.35278649
## MPG.highway  0.8351605  0.1083733 0.51104437 -0.17203453
## Turn.circle -0.8191302 -0.4769307 0.19260212 -0.25390387
## 
## $scores$corr.Y.xscores
##                      [,1]       [,2]        [,3]          [,4]
## EngineSize     -0.8292589 -0.1274496  0.14074067 -0.0445090128
## Horsepower     -0.8075114  0.2336283  0.05902454  0.0007286105
## Length         -0.7549311 -0.1887275  0.22951172  0.0537477303
## Wheelbase      -0.7523878 -0.1761902  0.04335175 -0.0576622880
## Width          -0.7906897 -0.3062396  0.09680375 -0.0215698743
## Rear.seat.room -0.4650161 -0.1169981  0.02038383 -0.1136703998
## Weight         -0.9031314 -0.1142115 -0.08681681 -0.0020127371
## 
## $scores$corr.X.yscores
##                   [,1]        [,2]      [,3]        [,4]
## Price       -0.7440780  0.39785589 0.0434349 -0.00709763
## MPG.city     0.8319310  0.09826920 0.1480908 -0.09733541
## MPG.highway  0.7782199  0.07202961 0.3193668 -0.04946351
## Turn.circle -0.7632559 -0.31757228 0.1220890 -0.06183494
## 
## $scores$corr.Y.yscores
##                      [,1]       [,2]        [,3]         [,4]
## EngineSize     -0.8899266 -0.1910516  0.22571229 -0.164054095
## Horsepower     -0.8666458  0.3507820  0.09477050  0.005420179
## Length         -0.8101314 -0.2829884  0.36742763  0.210614594
## Wheelbase      -0.8073732 -0.2641144  0.07099922 -0.212050336
## Width          -0.8485332 -0.4594099  0.15564052 -0.076908214
## Rear.seat.room -0.4963790 -0.1784893  0.03262522 -0.433920216
## Weight         -0.9692011 -0.1711557 -0.13687502 -0.001786927

# Gráfico de barras con las correlaciones canónicas
corr_df <- data.frame(
  num_dim = 1:length(res.cc$cor),
  corr_val = res.cc$cor
)

ggplot(corr_df, aes(x = as.factor(num_dim), y = corr_val)) +
  geom_col(fill = "green4") +
  geom_text(aes(label = round(corr_val, 2)), vjust = -0.3, color = "red") +
  labs(
    title = "GRÁFICO SELECCIÓN NÚMERO DE DIMENSIONES",
    x = "Dimensión",
    y = "Correlación Canónica"
  ) +
  theme_bw()

# Gráfico de variables en el plano canónico (dimensiones 1 y 2)
plt.cc(res.cc, d1 = 1, d2 = 2, var.label = TRUE)

Representamos gráficamente las correlaciones canónicas obtenidas para evaluar cuántas dimensiones resultan relevantes. A partir del gráfico, confirmamos que las tres primeras dimensiones presentan valores elevados de correlación, siendo especialmente significativa la primera, con un valor superior a 0.93. Posteriormente, generamos los gráficos de variables e individuos asociados a las dos primeras dimensiones para facilitar su interpretación.

La primera dimensión contrapone a los vehículos de bajo consumo frente a los más caros y de mayor radio de giro (menos maniobrables). Estos últimos presentan una correlación positiva con todas las características físicas del vehículo, como tamaño, peso o potencia.

La segunda dimensión se relaciona positivamente con el precio y la potencia, y negativamente con el radio de giro y la anchura. Por tanto, esta dimensión parece recoger el perfil de vehículos caros, potentes, maniobrables y compactos, características habituales en los modelos deportivos.

La tercera dimensión recoge, principalmente, una fuerte correlación negativa con el consumo en carretera y una débil positiva con el peso, lo cual identifica a vehículos pensados para trayectos largos y con alta eficiencia.

En conclusión, el análisis de correlación canónica revela que existe una fuerte relación entre las características físicas de los vehículos y sus variables de precio, consumo y maniobrabilidad. Las tres primeras dimensiones extraídas permiten caracterizar diferentes perfiles de vehículo: utilitarios económicos, modelos grandes y potentes, y deportivos eficientes.